home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-13 / ae_14.zip / SPLIT.PAS < prev   
Pascal/Delphi Source File  |  1991-03-12  |  7KB  |  199 lines
  1. program split ;
  2.  
  3. {-----------------------------------------------------------------------------}
  4. { SPLIT -- utility to split text files into smaller chunks                    }
  5. { syntax: SPLIT <filename> [<chunksize>]                                      }
  6. { chunksize can be given in bytes or in k                                     }
  7. { file name of chunks is same as input file                                   }
  8. { file extension of chunks is '.000', '.001', '.002' etc.                     }
  9. {-----------------------------------------------------------------------------}
  10.  
  11. {$M 16348,65535,65535}
  12. {$B-}
  13. {$I-}
  14.  
  15. uses Crt,Dos ;
  16.  
  17. const Version = '1.0' ;
  18.       Date = '12 Mar 1991' ;
  19.       MaxWord = 65535 ;      { maximum chunk size }
  20.       DefaultChunkSize = 60000 ;
  21.       
  22. var InFile, OutFile : file ;
  23.     InFileName, OutFileName : PathStr ;
  24.     DiskError : word ;
  25.     ChunkSize, ChunkNr : longint ;
  26.     ChunkSizeStr : string ;         { string representation of ChunkSize }
  27.     ChunkNrStr : string[3] ;        { string representation of ChunkNr }
  28.     code : integer ;                { result of string->number conversion }
  29.     BufPtr : pointer ;
  30.     FileDir : DirStr ;              { directory part of InFileName }
  31.     FileName : NameStr ;            { file name part of InFileName }
  32.     FileExt : ExtStr ;              { file extension part of InFileName }
  33.     Ready : boolean ;
  34.     Answer : char ;                 { overwrite existing output file? }
  35.     BytesRead,BytesWritten : integer ;
  36.     EF : char ;                     { end-of-file character }
  37.  
  38. {-----------------------------------------------------------------------------}
  39. { Indicates whether a filename contains wildcard characters                   }
  40. {-----------------------------------------------------------------------------}
  41.  
  42. function Wildcarded (Name : PathStr) : boolean ;
  43.  
  44. begin
  45. Wildcarded := (Pos('*',Name) <> 0) or (Pos('?',Name) <> 0) ;
  46. end ;
  47.  
  48. {-----------------------------------------------------------------------------}
  49. { Returns True if the file <FileName> exists, False otherwise.                }
  50. {-----------------------------------------------------------------------------}
  51.  
  52. function Exists (FileName : PathStr) : boolean ;
  53.  
  54. var SR : SearchRec ;
  55.  
  56. begin
  57. FindFirst (FileName,ReadOnly + Hidden + SysFile,SR) ;
  58. Exists := (DosError = 0) and (not Wildcarded(Filename)) ;
  59. end ;
  60.  
  61. {-----------------------------------------------------------------------------}
  62. { Reads the result of the last I/O operation into the DiskError variable      }
  63. { and produces an error message if an error has occurred.                     }
  64. {-----------------------------------------------------------------------------}
  65.  
  66. procedure CheckDiskError ;
  67.  
  68. var ErrorText : string ;
  69.  
  70. begin
  71. DiskError := IOResult ;
  72. if DiskError <> 0
  73.    then begin
  74.         case DiskError of
  75.              2   : ErrorText := 'File not found' ;
  76.              3   : ErrorText := 'Path not found' ;
  77.              5   : ErrorText := 'File acces denied' ;
  78.              101 : ErrorText := 'Disk write error' ;
  79.              150 : ErrorText := 'Disk is write-protected' ;
  80.              152 : ErrorText := 'Drive not ready' ;
  81.              159 : ErrorText := 'Printer out of paper' ;
  82.              160 : ErrorText := 'Device write fault' ;
  83.              else  begin
  84.                    Str (DiskError,ErrorText) ;
  85.                    ErrorText := 'I/O error ' + ErrorText ;
  86.                    end ;
  87.              end ; { of case }
  88.         Writeln ;
  89.         Writeln (Chr(7),ErrorText) ;
  90.         end ; { of if }
  91. end ;
  92.  
  93. {-----------------------------------------------------------------------------}
  94.  
  95. begin
  96. Writeln ('SPLIT -- utility to split text files into smaller chunks') ;
  97. Writeln ('Version ',Version,'  ',Date) ;
  98. Writeln ;
  99. EF := #26 ;
  100. if (ParamCount < 1) or (ParamCount > 2)
  101.    then begin
  102.         { wrong number of parameters: give help then quit program }
  103.         Writeln ('Use: SPLIT <filename> [<chunksize>]') ;
  104.         Exit ; { not nice programming but to prevent huge nesting of ifs }
  105.         end ;
  106. if ParamCount = 1
  107.    then begin
  108.         { no chunk size given: use default }
  109.         ChunkSize := DefaultChunkSize ;
  110.         code := 0 ;
  111.         end
  112.    else begin
  113.         ChunkSizeStr := ParamStr(2) ;
  114.         if UpCase(ChunkSizeStr[Length(ChunkSizeStr)]) = 'K'
  115.            then begin
  116.                 { chunk size given in kilobytes }
  117.                 Val (Copy(ChunkSizeStr,1,Length(ChunkSizeStr)-1),
  118.                      ChunkSize,code) ;
  119.                 ChunkSize := ChunkSize * 1024 ;
  120.                 end
  121.            else { chunk size given in bytes }
  122.                 Val (ChunkSizeStr,ChunkSize,code) ;
  123.         end ;
  124. if code <> 0
  125.    then begin
  126.         { conversion of chunk size string to number not successful }
  127.         Writeln ('Invalid chunk size. Enter number of bytes or') ;
  128.         Writeln ('number of kilobytes followed by "k".') ;
  129.         Exit ;
  130.         end ;
  131. { decrease ChunkSize with 1 to allow for EOF char }
  132. Dec (ChunkSize) ;
  133. if ChunkSize > MaxWord
  134.    then begin
  135.         Write ('Invalid chunk size. ') ;
  136.         Writeln ('Maximum ',MaxWord,' bytes (or ',MaxWord div 1024,'k)') ;
  137.         Exit ;
  138.         end ;
  139. InFileName := FExpand (ParamStr(1)) ;
  140. if not Exists(InFileName)
  141.    then begin
  142.         Writeln ('File "',InFileName,'" not found') ;
  143.         Exit ;
  144.         end ;
  145. Assign (InFile,InFileName) ;
  146. Reset (InFile,1) ;
  147. CheckDiskError ;
  148. { allocate memory buffer for contents of file }
  149. GetMem (BufPtr,ChunkSize) ;
  150. ChunkNr := 0 ;
  151. FSplit (InFileName,FileDir,FileName,FileExt) ;
  152. Ready := (DiskError <> 0) ;
  153. while not Ready do
  154.       begin
  155.       { construct output file name }
  156.       Str (ChunkNr,ChunkNrStr) ;
  157.       while Length(ChunkNrStr) < 3 do
  158.             ChunkNrStr := '0' + ChunkNrStr ;
  159.       OutFileName := FExpand (FileName + '.' + ChunkNrStr) ;
  160.       if Exists (OutFileName)
  161.          then begin
  162.               Write ('File "',OutFileName,'" already exists. ') ;
  163.               Write ('Skip/Overwrite/Abort ? (S/O/A) ') ;
  164.               repeat Answer := UpCase(ReadKey) ;
  165.                      if Answer = Chr(0)
  166.                         then Answer := ReadKey ;
  167.               until Answer in ['S','O','A'] ;
  168.               Writeln (Answer) ;
  169.               end
  170.          else Answer := 'O' ;
  171.       case Answer of
  172.            'S' : { skip }
  173.                  Inc (ChunkNr) ;
  174.            'O' : begin
  175.                  { overwrite: read and write chunk }
  176.                  BlockRead (InFile,BufPtr^,ChunkSize,BytesRead) ;
  177.                  CheckDiskError ;
  178.                  Write ('File "',OutFileName,'" ... ') ;
  179.                  Assign (OutFile,OutFileName) ;
  180.                  ReWrite (OutFile,1) ;
  181.                  BlockWrite (OutFile,BufPtr^,BytesRead,BytesWritten) ;
  182.                  { write end-of-file char }
  183.                  BlockWrite (OutFile,EF,1) ;
  184.                  Close (OutFile) ;
  185.                  CheckDiskError ;
  186.                  Writeln (BytesWritten+1,' bytes written.') ;
  187.                  Ready := (BytesRead <> ChunkSize) or
  188.                           (BytesWritten <> BytesRead) or
  189.                           (DiskError <> 0) ;
  190.                  Inc (ChunkNr) ;
  191.                  end ;
  192.            'A' : { abort }
  193.                  Ready := True ;
  194.            end ; { of case }
  195.       Writeln ;
  196.       end ; { of while }
  197. Close (InFile) ;
  198. end.
  199.